home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MISC.SWG / 0083_Checkbook Number.pas < prev    next >
Pascal/Delphi Source File  |  1994-01-27  |  6KB  |  152 lines
  1. {
  2. From: WAYNE MOSES
  3. Subj: Spell a Number
  4. ---------------------------------------------------------------------------
  5.  *> Quoting Chris Serino to All on 01-04-94  17:28
  6.  *> Re: Help Looking for a Number
  7.  
  8.  Hello Chris:
  9.  
  10.  CS> I'm in the process of writing a Checkbook program for my Job and I
  11.  CS> was  wondering if anyone out there has a routine to convert a check
  12.  CS> amount written  in numerical to text.  Here's an example of what I
  13.  CS> need. Input Variable :  142.50
  14.  CS> Needed Output  : One Hundred Foury Two 50/100--------------------
  15.  
  16.  Weeeelllll ... since I am not really interested in releasing my personal
  17.  check writing program to the world, I'll upload what I wrote last month.
  18.  
  19.  ------- 8< ------------[ CUT LINE ]-------------- >8 -------
  20. }
  21. Function Translate(var DollarAmt : real) : string;
  22.  
  23. (*
  24.    This is a module that converts the numerical dollar amount to a string,
  25.    for example it converts $156.15 to :
  26.  
  27.                'One Hundred and Fifty Six dollars ------------15/xx'.
  28.  
  29.    The field length of the translated amount is limited to 53 characters.
  30.  
  31.    Amounts up to and including $99,999.99 are supported.  I rarely write
  32.    cheques larger than that, so they can be written by hand. ;-)
  33.  
  34.    ======================================================================
  35.    Dedicated to the PUBLIC DOMAIN, this software code has been tested and
  36.    used under TP 6.0/DOS and MS-DOS 6.2.
  37.    ======================================================================
  38. *)
  39.  
  40. const
  41.      SingleSpelled : array[1..9] of string = ('One ','Two ','Three ','Four ',
  42.                                               'Five ','Six ','Seven ','Eight ',
  43.                                               'Nine ');
  44.  
  45.      TeenSpelled : array[1..9] of string = ('Eleven ','Twelve ','Thirteen ',
  46.                                             'Fourteen ','Fifteen ','Sixteen ',
  47.                                             'Seventeen ','Eighteen ','Nineteen');
  48.  
  49.      TenSpelled : array[1..9] of string = ('Ten ','Twenty ','Thirty ','Forty ',
  50.                                            'Fifty ','Sixty ','Seventy ','Eighty',
  51.                                            'Ninety ');
  52.  
  53. var
  54.    Dollars, Cents,
  55.    SingleStr, TenStr, HundredStr, ThousandStr   : string;
  56.    Singles, Tens, Hundreds, Thousands, k, l     : integer;
  57.  
  58. begin
  59.      if DollarAmt = 0 then         (* The amount to be translated is 0.00 *)
  60.      begin                         (* so the Dollars and Cents must be    *)
  61.           Dollars := 'Zero ';      (* to reflect this.                    *)
  62.           Cents   := '00';
  63.      end
  64.  
  65.      else
  66.      begin                         (* Non trivial value for DollarAmt     *)
  67.  
  68.      SingleStr := ''; TenStr := ''; HundredStr := ''; ThousandStr := '';
  69.  
  70.      { Parse the Cents out of DollarAmt }
  71.  
  72.      Str(frac(DollarAmt):0:2, Cents);
  73.      if frac(DollarAmt) > 0 then
  74.         Cents := copy(Cents,pos('.',Cents)+1,2)
  75.      else
  76.          Cents := '00';
  77.  
  78.      { Next parse the Dollars out of DollarAmt }
  79.  
  80.      Str(int(DollarAmt):1:0, Dollars);
  81.  
  82.      { Now, define the number of Singles, Tens, Hundreds, and Thousands }
  83.  
  84.      Thousands   := trunc(DollarAmt/1000);
  85.  
  86.      Hundreds    := trunc(DollarAmt/100)-Thousands*10;
  87.      HundredStr  := SingleSpelled[Hundreds];
  88.  
  89.      Tens        := trunc(DollarAmt/10)-(Thousands*100+Hundreds*10);
  90.  
  91.      Singles     := trunc(DollarAmt)-(Thousands*1000+Hundreds*100+Tens*10);
  92.      SingleStr   := SingleSpelled[Singles];
  93.  
  94.      case Tens of
  95.      1    : begin
  96.                  TenStr := TeenSpelled[Singles];
  97.                  SingleStr := '';
  98.             end;
  99.      2..9 : TenStr := TenSpelled[Tens];
  100.      end;
  101.  
  102.      case Thousands of
  103.      10,20,
  104.      30,50,
  105.      60,70,
  106.      80,90  : ThousandStr := TenSpelled[trunc(Thousands/10)];
  107.      1..9   : ThousandStr := SingleSpelled[Thousands];
  108.      11..19 : ThousandStr := TeenSpelled[Thousands-10];
  109.  
  110.      21..29 : ThousandStr := TenSpelled[trunc(Thousands/10)]+
  111.                              SingleSpelled[Thousands-20];
  112.      31..39 : ThousandStr := TenSpelled[trunc(Thousands/10)]+
  113.                              SingleSpelled[Thousands-30];
  114.      41..49 : ThousandStr := TenSpelled[trunc(Thousands/10)]+
  115.                              SingleSpelled[Thousands-40];
  116.      51..59 : ThousandStr := TenSpelled[trunc(Thousands/10)]+
  117.                              SingleSpelled[Thousands-50];
  118.      61..69 : ThousandStr := TenSpelled[trunc(Thousands/10)]+
  119.                              SingleSpelled[Thousands-60];
  120.      71..79 : ThousandStr := TenSpelled[trunc(Thousands/10)]+
  121.                              SingleSpelled[Thousands-70];
  122.      81..89 : ThousandStr := TenSpelled[trunc(Thousands/10)]+
  123.                              SingleSpelled[Thousands-80];
  124.      91..99 : ThousandStr := TenSpelled[trunc(Thousands/10)]+
  125.                              SingleSpelled[Thousands-90];
  126.      end;
  127.  
  128.      if Thousands > 0 then
  129.         Dollars := ThousandStr+'Thousand '+HundredStr+'Hundred & '
  130.                    + TenStr + SingleStr
  131.      else
  132.      if (Hundreds > 0) and (Thousands = 0) then
  133.         Dollars := HundredStr+'Hundred and '+ TenStr + SingleStr
  134.      else
  135.          Dollars := TenStr + SingleStr;
  136.  
  137.      end;                              (* End of block for non-trivial    *)
  138.                                        (* value for DollarAmt             *)
  139.      l := length(Dollars);
  140.  
  141.      for k := 1 to 60-(10+l+length(Cents)) do
  142.          Dollars := Dollars+'-';
  143.  
  144.      If Thousands < 100 then
  145.         Translate := Dollars+Cents+'/xx'
  146.      else
  147.          begin
  148.          TextColor(Yellow+Blink);
  149.          Translate := '******** INVALID!  THIS AMOUNT NOT SUPPORTED ********';
  150.          end;
  151. end;
  152.